perm filename CLEFXG.F4[NEW,LCS]12 blob sn#464133 filedate 1979-07-31 generic text, type T, neo UTF8
C *** CLEFS, GETLIB

	SUBROUTINE CLEFS
C**** NOW HOLDS 14 LIBE. FILES AT ONCE. ******* 
C**** KPNT(154) =14*11  JCLEF(4900) =14*350    NAM(14) =14*1  LIBNUM=14
C**** IF CHANGES, FIX DIMENSIONS AND DATA (LIBNUM)
	DIMENSION KPNT(154),JCLEF(4900),NAM(14),RCMIN(4),CM(4)
	COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
	DATA LIBNUM/14/
	DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
	EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),
	1 (R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
	2,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(R3,RJQ(1)),(J8,JQ(6))
	IF(R6.GE.100)R6=R6-100
C SOMETIMES MAKE SIZE +100 FOR PARTS PROGRAM.
	CALL NOZERO(R6)
	IF(R7.EQ.0)R7=R6
C  IF P7 = 0, IT WILL EQUAL P6.
	IF(JA.GT.10)GO TO 10
	NAME='CLEFA'
	IF(J5.LT.20)GO TO 50
	R6=R6*.3
C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
	R7=R7*.3
	GO TO 50
10	IF(NAME.EQ.NJR)GO TO 50
	IF(NAME.EQ.0)GO TO 20
	IF(NJR.EQ.0)GO TO 50
20	IF(NJR.EQ.0)GO TO 30
C  TO PICK UP BASIC DRAW NAME FROM P10
	NAME=NJR
	GO TO 50
30	TYPE 40
40	FORMAT(' SET P10=1'/)
C  LEADS TO PROPER FILE CALL
50	JTAIL=-1
	IF(JA.NE.3)GO TO 60
	IF(R5.NE.0.8)GO TO 60
	JTAIL=0
C R5=0.8 FOR TREBLE CLEF WITH 8 ON TAIL. (FOR TENOR VOCAL)
60	NM=NAME+2*(J5/10)
C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
	JEZ=MOD(J5,10)+1
70	DO 80 KNM=1,LIBNUM
C***** LIBNUM IS NUMBER OF POSSIBLE LIBE FILES.
80	IF(NM.EQ.NAM(KNM))GO TO 110
C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	NPP=0
	IF(JA.NE.11)GO TO 90
C  DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
	NPP=-1
	IF(LOOKL(NM).LT.0)GO TO 100
C JUMP IF ___.LIB IS FOUND IN ,LIB AREA.  DOES LOOKUP AND INIT.
	IF(LOOKF(NM).LT.0)GO TO 90
	CALL TYPWRD(NM)
	CALL TYPSTR(' -- NOT FOUND')
  	CALL TYPCRLF
	RETURN
90 	CALL GETFI2(NM,NPP)
100	KNM=KX+1
	NAM(KNM)=NM
	CALL GETLIB(JCLEF,KPNT,KX)
	KX=KNM
	IF(KX.EQ.LIBNUM)KX=0
C**** LIBNUM IS NUMBER OF POSSIBLE LIBE FILES.

110	IF(J5.GT.3)GO TO 130
	IF(JA.NE.3)GO TO 130
C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)  MINI→R4+100
C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
	IF(IABS(J4).LT.80)GO TO 120
	RSTJ2=.8*RSTJ2
C  TO SET HGT. OF MINI CLEFS
	R4=R4+CM(JEZ)
C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
120	IF(JEZ.NE.4)GO TO 130
	R4=R4+2
	JEZ=3
C   ABOVE IS NOW AT TOP

130	A=R4
	R4=A+2.9
C  ADJUSTS HEIGHT(??)
	CALL CENTX
	R4=A

	L=KNM-1
	L=KPNT(L*11+JEZ)+L*350
C NOW GET POINTER IN JCLEF ARRAY FOR THIS ITEM.
	IF(L.LE.0)RETURN
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)

	IF(J9.EQ.0)GO TO 150
C***** ROTATE *******
	R7=R7*RSTJ2
	R6=R6*RSTJ2
	N=JCLEF(L)
	KNT=701
C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
	JCLEF(KNT)=N
	DO 140 K=L+1,N+L-1
	CALL UNPACK(J,M,JCLEF(K))
	X=J*R6
	Y=M*R7
	JJ=JCLEF(K)/100000000
	AX=ATAN2(X,Y)*57.29578
	HYP=SQRT(X**2+Y**2)
	ROT=DEG+AX
	J=ROFF(HYP*COSD(ROT))
	M=ROFF(HYP*SIND(ROT))
	KNT=KNT+1
	IF(J)J=1000-J
	IF(M)M=1000-M
140	JCLEF(KNT)=M*10000+J+JJ*100000000
	L=701
C  ***********  SEE AT TOP **********
	R6=1.
	R7=1.
	RSTJ2=1.
C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
	NAM(3)=0
C  WIPES OUT DATA AREA FOR NM3
C  R9=P9=DEGREES OF ROTATION (0-360)
	IF(KK.GT.350)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
150	A=-1
C  FLAG FOR THICKNESS OR NO.
	IF(J8.EQ.-2)GO TO 190
	IF(R8.LE.0)GO TO 160
	A=0
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
	CALL THICK
C  SEE CLEFZ.F4 FOR "THICK" CODE  (THICK IS IN MFAIL.FAI)
	GO TO 190
160	IF(IPLT)170,170,190
170	DO 180 K=L+1,JCLEF(L)+L-1
	IF(JCLEF(K).LT.200000000)GO TO 180
	JEZ=JCLEF(L)-1
	IF(K.GT.L+1)JEZ=JEZ-K+L+1
	CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
	GO TO 190
180	CONTINUE
C  FILLS ONLY WHEN PLOTING OR R8=-1
190	CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
	IF(A)GO TO 220
	IF(J8.NE.0)GO TO 200
	IF(J9.EQ.0)GO TO 220
	GO TO 210
200	J8=J8-1
	R3=R3+XDIS
C  XDIS=1 PLOTTER STEP NO MATTER WHAT SIZE FACTOR USED
210	IF(J9.EQ.0)GO TO 190
	J9=J9-1
	CENTR=CENTR+XDIS
	GO TO 190
220	IF(JTAIL)RETURN
	JTAIL=-1
	JA=10
	JEZ=9
C  JEZ=9 MAKES AN 8 APPEAR UNDER TAIL OF TREBLE CLEF.
	R6=.2
	R7=R6
	NM='BDR40'
	R3=R3+14*RSTJ2
	R4=-4
	GO TO 70
	END

	SUBROUTINE GETLIB(JCLEF,KPNT,KX)
C GETS LIBRARY AND PUTS IT IN RIGHT SLOT
	DIMENSION JCLEF(1),KPNT(1)
	N=KX*11+1
C POINTER TO DIRECTORY OF EACH FINE
	CALL FASTI2(KPNT(N),11)
	N=KPNT(N+10)
C WORD COUNT IS IN 11TH WORD
	IF(N.LE.350)GO TO 10
C       CALL TYPWRD(NM)
	CALL TYPSTR('  FILE TOO BIG ')
	N=350
C GO ON ANYWAY
10	CALL FASTI2(JCLEF(KX*350+1),N)
	END